VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Webcam Timelapse v0.03"
   ClientHeight    =   9975
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   9855
   BeginProperty Font 
      Name            =   "Arial"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   665
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   657
   StartUpPosition =   3  'Windows Default
   Begin VB.Frame Frame1 
      Caption         =   "Panel"
      Height          =   2415
      Left            =   120
      TabIndex        =   1
      Top             =   7440
      Width           =   9615
      Begin VB.Frame Frame5 
         Caption         =   "Calculation"
         Height          =   2055
         Left            =   2160
         TabIndex        =   19
         Top             =   240
         Width           =   2535
         Begin VB.Label lblCalc3 
            Caption         =   "8640"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Left            =   1800
            TabIndex        =   25
            Top             =   720
            Width           =   615
         End
         Begin VB.Label Label7 
            Alignment       =   1  'Right Justify
            Caption         =   "Photo's per day:"
            Height          =   255
            Left            =   120
            TabIndex        =   24
            Top             =   720
            Width           =   1575
         End
         Begin VB.Label lblCalc2 
            Caption         =   "360"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Left            =   1800
            TabIndex        =   23
            Top             =   480
            Width           =   615
         End
         Begin VB.Label Label6 
            Alignment       =   1  'Right Justify
            Caption         =   "Photo's per hour:"
            Height          =   255
            Left            =   120
            TabIndex        =   22
            Top             =   480
            Width           =   1575
         End
         Begin VB.Label lblCalc1 
            Caption         =   "6"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Left            =   1800
            TabIndex        =   21
            Top             =   240
            Width           =   615
         End
         Begin VB.Label Label5 
            Alignment       =   1  'Right Justify
            Caption         =   "Photo's per minute:"
            Height          =   255
            Left            =   120
            TabIndex        =   20
            Top             =   240
            Width           =   1575
         End
      End
      Begin VB.Frame Frame4 
         Caption         =   "Settings"
         Height          =   2055
         Left            =   120
         TabIndex        =   11
         Top             =   240
         Width           =   1935
         Begin VB.TextBox txtInterval 
            Height          =   315
            Left            =   840
            TabIndex        =   12
            Text            =   "10"
            Top             =   240
            Width           =   495
         End
         Begin VB.Label Label3 
            Caption         =   "sec."
            Height          =   255
            Left            =   1440
            TabIndex        =   14
            Top             =   240
            Width           =   375
         End
         Begin VB.Label Label4 
            Alignment       =   1  'Right Justify
            Caption         =   "Interval:"
            Height          =   255
            Left            =   120
            TabIndex        =   13
            Top             =   240
            Width           =   615
         End
      End
      Begin VB.CommandButton cmdTakePic 
         Caption         =   "Take Picture"
         Enabled         =   0   'False
         Height          =   375
         Left            =   8280
         TabIndex        =   10
         Top             =   960
         Width           =   1215
      End
      Begin VB.Frame Frame3 
         Caption         =   "Stop"
         Height          =   2055
         Left            =   4800
         TabIndex        =   9
         Top             =   240
         Width           =   2535
         Begin VB.TextBox txtStopAt 
            Height          =   315
            Left            =   840
            TabIndex        =   17
            Text            =   "50"
            Top             =   600
            Width           =   495
         End
         Begin VB.OptionButton optStop2 
            Caption         =   "After              pictures"
            Height          =   255
            Left            =   120
            TabIndex        =   16
            Top             =   600
            Width           =   2055
         End
         Begin VB.OptionButton optStop1 
            Caption         =   "When I say so"
            Height          =   255
            Left            =   120
            TabIndex        =   15
            Top             =   240
            Value           =   -1  'True
            Width           =   1695
         End
         Begin VB.Label lblCalc 
            Caption         =   "That is 500 seconds."
            Height          =   255
            Left            =   360
            TabIndex        =   18
            Top             =   960
            Width           =   1935
         End
      End
      Begin VB.Timer Timer 
         Enabled         =   0   'False
         Interval        =   1000
         Left            =   7440
         Top             =   360
      End
      Begin VB.CommandButton cmdStop 
         Caption         =   "Stop Timer"
         Enabled         =   0   'False
         Height          =   375
         Left            =   8280
         TabIndex        =   8
         Top             =   600
         Width           =   1215
      End
      Begin VB.CommandButton cmdStart 
         Caption         =   "Start Timer"
         Height          =   375
         Left            =   8280
         TabIndex        =   7
         Top             =   240
         Width           =   1215
      End
      Begin VB.Frame Frame2 
         Caption         =   "Status"
         Height          =   855
         Left            =   7440
         TabIndex        =   2
         Top             =   1440
         Width           =   2055
         Begin VB.Label lblPicturesTaken 
            Caption         =   "0"
            Height          =   255
            Left            =   1440
            TabIndex        =   6
            Top             =   480
            Width           =   495
         End
         Begin VB.Label lblStatus 
            Caption         =   "Off"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            ForeColor       =   &H000000FF&
            Height          =   255
            Left            =   1440
            TabIndex        =   5
            Top             =   240
            Width           =   495
         End
         Begin VB.Label Label2 
            Alignment       =   1  'Right Justify
            Caption         =   "Pictures taken:"
            Height          =   255
            Left            =   120
            TabIndex        =   4
            Top             =   480
            Width           =   1215
         End
         Begin VB.Label Label1 
            Alignment       =   1  'Right Justify
            Caption         =   "Timer:"
            Height          =   255
            Left            =   120
            TabIndex        =   3
            Top             =   240
            Width           =   1215
         End
      End
   End
   Begin VB.PictureBox Stage 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   7200
      Left            =   120
      ScaleHeight     =   476
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   636
      TabIndex        =   0
      Top             =   120
      Width           =   9600
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Const WS_CHILD As Long = &H40000000
Const WS_VISIBLE As Long = &H10000000

Const WM_USER = 1024
Const WM_CAP_DRIVER_CONNECT = WM_USER + 10
Const WM_CAP_SET_PREVIEW = WM_USER + 50
Const WM_CAP_SET_PREVIEWRATE = WM_USER + 52
Const WM_CAP_DRIVER_DISCONNECT As Long = WM_USER + 11
Const WM_CAP_DLG_VIDEOFORMAT As Long = WM_USER + 41
Const WM_CAP_START As Long = WM_USER
Const WM_CAP_GRAB_FRAME_NOSTOP As Long = WM_CAP_START + 61
Const WM_CAP_FILE_SAVEDIB As Long = WM_CAP_START + 25
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Private Declare Function capCreateCaptureWindow Lib "avicap32.dll" Alias "capCreateCaptureWindowA" (ByVal a As String, ByVal b As Long, ByVal c As Integer, ByVal d As Integer, ByVal e As Integer, ByVal f As Integer, ByVal g As Long, ByVal h As Integer) As Long
'Private Declare Function capGrabFrameNoStop Lib "avicap32.dll" (ByVal hwnd As Long) As Boolean
'Private Declare Function capFileSaveDIB Lib "avicap32.dll" (ByVal hwnd As Long, ByVal szName As Long) As Boolean

Dim StopAt As Long

Dim CountTo As Long
Dim Counter As Long
Dim Framerate As Long
Dim PicturesTaken As Long
Dim TimeStamp As String

Dim HWDC As Long
Dim Capturing As Boolean

Dim FSO As New FileSystemObject

Private Sub cmdStart_Click()
    If IsNumeric(txtInterval) Then
        If IsNumeric(txtStopAt) Then
            Timer.Enabled = True
            
            Counter = 0
            CountTo = CLng(txtInterval)
            
            lblStatus.ForeColor = RGB(0, 255, 0)
            lblStatus.Caption = "On"
            lblPicturesTaken.Caption = "0"
            
            TimeStamp = Format(Date, "ddMMMyyyy") & "-" & Format(Time, "hhnnss")
            
            If FSO.FolderExists(App.Path & "\pictures\" & TimeStamp) Then
                FSO.DeleteFolder App.Path & "\pictures\" & TimeStamp
            End If
            FSO.CreateFolder App.Path & "\pictures\" & TimeStamp
            
            txtInterval.Enabled = False
            txtStopAt.Enabled = False
            
            optStop1.Enabled = False
            optStop2.Enabled = False
            
            If optStop2.Value Then
                StopAt = Val(txtStopAt)
            Else
                StopAt = -1
            End If
            
            cmdStop.Enabled = True
            cmdTakePic.Enabled = True
            cmdStart.Enabled = False
        Else
            MsgBox "The number of frames to stop at can only exist out of numbers.", vbCritical, "Error"
        End If
    Else
        MsgBox "The interval can only exist out of numbers.", vbCritical, "Error"
    End If
End Sub

Private Sub cmdStop_Click()
    Timer.Enabled = False
    
    MsgBox PicturesTaken & " picture(s) taken.", vbInformation, "Info"
    PicturesTaken = 0
    
    lblStatus.ForeColor = RGB(255, 0, 0)
    lblStatus.Caption = "Off"
    
    txtInterval.Enabled = True
    txtStopAt.Enabled = True
    
    optStop1.Enabled = True
    optStop2.Enabled = True
    
    cmdStart.Enabled = True
    cmdTakePic.Enabled = False
    cmdStop.Enabled = False
End Sub

Private Sub cmdTakePic_Click()
    TakePic
End Sub

Private Sub Form_Load()
    On Error GoTo err
    
    Stage.Width = CInt(modIni.ReadINI("MAIN", "Width", "Config.ini"))
    Stage.Height = CInt(modIni.ReadINI("MAIN", "Height", "Config.ini "))
    Framerate = CInt(modIni.ReadINI("MAIN", "Framerate", "Config.ini"))
    
    HWDC = capCreateCaptureWindow("Webcam Timelapse v0.01", WS_CHILD Or WS_VISIBLE, 0, 0, Stage.Width, Stage.Height, Stage.hWnd, 0)
    If HWDC <> 0 Then
        Capturing = True
        Call SendMessage(HWDC, WM_CAP_DRIVER_CONNECT, 0&, 0&)
        Call SendMessage(HWDC, WM_CAP_SET_PREVIEWRATE, CLng(Framerate), 0&)
        Call SendMessage(HWDC, WM_CAP_SET_PREVIEW, CLng(True), 0&)
        Call SendMessage(HWDC, WM_CAP_DLG_VIDEOFORMAT, 0&, 0&)
    Else
        Capturing = False
        MsgBox "Webcam not found.", vbCritical, "Error!"
        End
    End If
    
    Exit Sub
err:
    MsgBox "Other error occourd than the webcam not being found! Error #" & err.Number & ": '" & err.Description & "'" & vbCrLf & "Webcam Timelapse will now shut down.", vbCritical, "Error!"
    End
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Call SendMessage(HWDC, WM_CAP_DRIVER_DISCONNECT, 0&, 0&)
End Sub

Sub TakePic()
    Dim Filename As String
    
    Filename = App.Path & "\pictures\" & TimeStamp & "\Picture " & (PicturesTaken + 1) & ".bmp"
    
    PicturesTaken = PicturesTaken + 1
    lblPicturesTaken.Caption = PicturesTaken
    
    Call SendMessage(HWDC, WM_CAP_GRAB_FRAME_NOSTOP, 0, 0&)
    Call SendMessage(HWDC, WM_CAP_FILE_SAVEDIB, 0&, ByVal CStr(Filename))
    
    If PicturesTaken = StopAt Then
        cmdStop_Click
    End If
End Sub

Private Sub Timer_Timer()
    If Counter + 1 = CountTo Then
        TakePic
        
        Counter = 0
    Else
        Counter = Counter + 1
    End If
End Sub

Private Sub txtInterval_Change()
    If Not IsNumeric(txtInterval) Then
        txtInterval.BackColor = RGB(255, 0, 0)
    Else
        txtInterval.BackColor = RGB(255, 255, 255)
        CalcNew
    End If
End Sub

Private Sub txtStopAt_Change()
    If Not IsNumeric(txtStopAt) Then
        txtStopAt.BackColor = RGB(255, 0, 0)
    Else
        txtStopAt.BackColor = RGB(255, 255, 255)
        CalcNew
    End If
End Sub

Sub CalcNew()
    On Error Resume Next
    
    Dim S As Long
    Dim I As Long
    If IsNumeric(txtStopAt) And IsNumeric(txtInterval) Then
        S = Val(txtStopAt)
        I = Val(txtInterval)
        
        lblCalc.Caption = "That is " & (S * I) & " seconds."
        
        lblCalc1.Caption = CStr(60 / I)
        lblCalc2.Caption = CStr(60 * (60 / I))
        lblCalc3.Caption = CStr(24 * (60 * (60 / I)))
    End If
End Sub
